home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Module source / disasm < prev    next >
Encoding:
Text File  |  1995-10-23  |  20.7 KB  |  878 lines  |  [TEXT/MSET]
  1. \ PowerPC 601 disassembler
  2. \ Copyright 1993-1994 Xan Gregg  All Rights Reserved
  3. \    Permission is granted for internal distribution by Creative Solutions, Inc.
  4.  
  5. \    Permission also granted for Mops distribution.  Mops mods made by
  6. \    Mike Hore.
  7.  
  8.  
  9. DECIMAL
  10.  
  11. : dbgr    postpone db  ;    immediate        \ db has a different meaning here!
  12.  
  13. 0    value    curAddr
  14. 0    value    curInstr
  15. 0    value    range_start
  16. 0    value    range_end
  17.  
  18. 0    value    hiAddr        \ highest address branched to
  19.  
  20. create    instrText    256 allot
  21. create    hex.text    256 allot
  22.  
  23.  
  24. \ NAME? and .NAME will probably end up in the main dictionary in the
  25. \ native PPC version.
  26.  
  27. : NAME?  { xt \ addr len -- addr len true | -- false }
  28.     xt 2-
  29.     -1 traverse
  30.     n>count  -> len  -> addr
  31.     addr len +  3 +  $ fffffffc and
  32.     xt 2- =
  33.     IF        addr len true
  34.     ELSE    false
  35.     THEN
  36. ;
  37.  
  38. : .NAME  { xt -- }
  39.     xt range_start u>=  xt range_end u<= and  0EXIT
  40.     xt name? IF  type  ELSE  ." (no name)"  THEN
  41. ;
  42.  
  43. : append.text  ( addr ) { cnt target -- }
  44.     target c@ 1+ target + cnt cmove 
  45.     target c@ cnt + target c! ;
  46.  
  47. : put.ch ( char -- | put char into next instrText position )
  48.     instrText c@ 1+ dup instrText c! ( update counter )
  49.     instrText + c! ; ( store the character )
  50.  
  51. : put$ ( addr len -- | put string into next text position )
  52.     ( count ) instrText append.text ;
  53.  
  54. : trimOff  ( n -- )
  55.     instrText c@ swap - instrText c! ;
  56.  
  57. : put>  ( put next character into instrText )
  58.     postpone [char]
  59.     postpone put.ch  ;        immediate
  60.  
  61. : put.unsigned.hex  ( n\digits -- | writes unsigned n into instrText )
  62.     base >r hex
  63.     swap 0 <# #s #> rot min instrText append.text
  64.     r> -> base ;
  65.  
  66. : ?negate(bits)  { n bits \ flag shftcnt -- flag }
  67.     32 bits -  -> shftcnt
  68.     0 -> flag
  69.     n shftcnt scale 
  70.     dup 0< 
  71.         if negate
  72.            true -> flag
  73.         then
  74.     shftcnt negate scale
  75.     flag ;
  76.  
  77. : ?negate  { n digits -- abs digits flag }  \ true if "negative"
  78.     n digits 4* ?negate(bits)
  79.     digits swap ;
  80.  
  81. : put.signed.hex  ( n\digits -- | writes signed n into instrText )
  82.     ?negate if put> -  then
  83.     put.unsigned.hex ;
  84.     
  85. : putUByte  put> $ 2 put.unsigned.hex ;
  86. : putSWord  put> $ 4 put.signed.hex ;
  87. : putUWord  put> $ 4 put.unsigned.hex ;
  88. : putSLong  put> $ 8 put.signed.hex ;
  89. : putULong  put> $ 8 put.unsigned.hex ;
  90.  
  91. 0    value    lastAddr
  92.  
  93. : putAddr  dup  -> lastAddr  putULong ;
  94.  
  95. : putDec#  ( n -- )
  96.     base >R 
  97.         decimal
  98.         dup abs 0 <# #s rot sign #> 
  99.         instrText append.text
  100.     R> -> base ;
  101.  
  102. : putBin#  ( n\bits -- )
  103.     put> b
  104.     base >R 
  105.         >R 2 -> base
  106.         0 <# R> 0 do # loop #>
  107.         instrText append.text
  108.     R> -> base ;
  109.  
  110. : putSPR  ( n -- )
  111.     case
  112.         0 of " MQ" put$ endof
  113.         1 of " XER" put$ endof 
  114.         4 of " RTCU" put$ endof 
  115.         5 of " RTCL" put$ endof 
  116.         6 of " DEC" put$ endof 
  117.         8 of " LR" put$ endof 
  118.         9 of " CTR" put$ endof 
  119.         ( else) " spr" put$ dup putDec#
  120.     endcase ;
  121.  
  122. : tab  ( -- )
  123.     instrText count + 10 blanks
  124.     10 instrText c! ;
  125.  
  126. \ -----------------------------------------------------------------
  127.  
  128.  
  129. create name$ 16 allot
  130.  
  131. : D>  { \ addr cnt -- }        \ Usage:    d> dINSTR <whatever>
  132.                             \ Compiles:    : dINSTR " INSTR" put$  <whatever>
  133. temp{  string+ s  }
  134.  
  135.     " : "  put: s
  136.     bl word count  -> cnt  -> addr
  137.     addr cnt add: s  bl +: s  & " +: s  bl +: s
  138.     addr 1+ cnt 1-  add: s  & " +: s  " put$ "  add: s
  139.     all: s  evaluate  ;
  140.  
  141.  
  142. : extract    ( a\b -- n )
  143.     curInstr over 31 - scale
  144.     >r swap - 1+ 1 swap scale 1- r> and ;
  145.  
  146.  
  147. \ ?EXCEPTION handles the special register names.  We'll need to change
  148. \ the MacForth ones to whatever Mops will use! - But as of Mops 2.5 this
  149. \ hasn't been finalized yet.
  150.  
  151. : ?exception     ( n -- n\false or true )
  152.     SELECT[    1    ]=> " r1/sys_SP"
  153.           [    2    ]=> " r2/TOC"
  154.           [    13    ]=>    " r13/mainData"
  155.           [    14    ]=>    " r14/modData"
  156.           [    15    ]=>    " r15/mainCode"
  157.           [    16    ]=>    " r16/modCode"
  158.           [    17    ]=>    " r17/RP"
  159.           [    18    ]=> " r18/SP"
  160.           [    19    ]=> " r19/FSP"
  161.           [    20    ]=> " r20/obj_base"
  162.           [    21    ]=>    " r21/I"
  163.            DEFAULT=>    false  EXIT
  164.     ]SELECT
  165.     put$ true ;
  166.  
  167. : putCond  ( n -- )
  168.     case
  169.         0 of " ge" endof
  170.         1 of " le" endof
  171.         2 of " ne" endof
  172.         3 of " ns" endof
  173.         4 of " lt" endof
  174.         5 of " gt" endof
  175.         6 of " eq" endof
  176.         7 of " so" endof
  177.     endcase put$ ;
  178.     
  179. : cond  { \ bi bo -- }
  180.     6 10 extract  -> bo
  181.     11 15 extract 3 and  -> bi
  182.     bo 4 and 0= if 
  183.         put> d
  184.         bo 2 and not if put> n then put> z
  185.     then
  186.     bo 16 and 0= if
  187.         bo 8 and -1 scale bi or putCond
  188.     then ;
  189.     
  190. : li
  191.     6 29 extract 2 scale
  192.     dup hex# 02000000 >= if hex# fc000000 or then    \ sign extend
  193.     curInstr 2 and 0= if curAddr 4- + then
  194.     curInstr 1 and 0= if dup hiAddr max -> hiAddr then
  195.     putAddr ;
  196.  
  197. : bd
  198.     16 29 extract 2 scale
  199.     extend    \ sign extend
  200.     curInstr 2 and 0= if curAddr 4- + then
  201.     curInstr 1 and 0= if dup hiAddr max -> hiAddr then
  202.     putAddr ;
  203.  
  204.  
  205.  
  206. : rReg        ?exception not if put> r putDec# then ;
  207. : frReg        " fr" put$ putDec# ;
  208. : crbReg    " cr" put$ 4 /mod putDec# put> _
  209.             case
  210.                 0 of " LT" endof 
  211.                 1 of " GT" endof 
  212.                 2 of " EQ" endof 
  213.                 3 of " SO" endof
  214.             endcase put$ ;
  215. : crfReg    " cr" put$ putDec# ;
  216. : comma        " , " put$ ;
  217. : rD        6 10 extract rReg ;
  218. : rS        6 10 extract rReg ;
  219. : rA        11 15 extract rReg ;
  220. : rB        16 20 extract rReg ;
  221. : rA,        rA comma ;
  222. : rA0,        11 15 extract if rA, else " 0, " put$ then ;
  223. : rB,        rB comma ;
  224. : rS,        rS comma ;
  225. : rD,        rD comma ;
  226. : (rA)        put> ( rA put> ) ;
  227. : simm        curInstr Lo2 extend putDec# ;
  228. : uimm        curInstr Lo2 putUWord ;
  229. : ?RC        curInstr 1 and if put> . then ;
  230. : crbD        6 10 extract crbReg ;
  231. : crbA,        11 15 extract crbReg comma ;
  232. : crbB        16 20 extract crbReg ;
  233. : crbD,        crbD comma ;
  234. : crfD        6 8 extract crfReg ;
  235. : crfS        11 13 extract crfReg ;
  236. : crfD,        crfD comma ;
  237. : crfD0,    6 8 extract if crfD comma then ;
  238. : frD        6 10 extract frReg ;
  239. : frS        6 10 extract frReg ;
  240. : frA,        11 15 extract frReg comma ;
  241. : frB        16 20 extract frReg ;
  242. : frC        21 25 extract frReg ;
  243. : frB,        frB comma ;
  244. : frC,        frC comma ;
  245. : frD,        frD comma ;
  246. : frS,        frS comma ;
  247. : ?LK        curInstr 1 and if put> l then ;
  248. : ?AA        curInstr 2 and if put> a then ;
  249. : MB        21 25 extract putDec# ;
  250. : ME        26 30 extract putDec# ;
  251. : NB        16 20 extract putDec# ;
  252. : SH        16 20 extract putDec# ;
  253. : SH,        SH comma ;
  254. : MB,        MB comma ;
  255. : ME,        ME comma ;
  256. : SPR        16 20 extract 5 scale 11 15 extract or putSPR ;
  257. : SPR,        SPR comma ;
  258. : ?condReg  11 13 extract ?dup if crfReg then ;
  259. : ?predict    10 10 extract if put> - then ;
  260. : disp        curInstr Lo2 extend putSWord ;
  261. : ?disp        curInstr Lo2 if disp then ;
  262. : SR        12 15 extract " sr" put$ putDec# ;
  263. : SR,        SR comma ;
  264. : TO,        6 10 extract " TO:" put$ 5 putBin# comma ;
  265. : CRM,        12 19 extract " CRM:" put$ 8 putBin# comma ;
  266. : FM,        7 14 extract " FM:" put$ 8 putBin# comma ;
  267. : IMM        16 19 extract 4 putBin# ;
  268.  
  269. : rArB            tab rA, rB ;
  270. : rA0rB            tab rA0, rB ;
  271. : rSrArB        tab rS, rA, rB ;
  272. : rDrArB        tab rD, rA, rB ;
  273. : rSrA0rB        tab rS, rA0, rB ;
  274. : rDrA0rB        tab rD, rA0, rB ;
  275. : RCrSrArB        ?RC rSrArB ;
  276. : RCrDrArB        ?rc rDrArB ;
  277. : rDrASIMM        tab rD, rA, simm ;
  278. : rDrA0SIMM        tab rD, rA0, simm ;
  279. : RCrDrA        ?rc tab rD, rA ;
  280. : RCrArS        ?rc tab rA, rS ;
  281. : rArSUIMM        tab rA, rS, uimm ;
  282. : RCrArSrB        ?rc tab rA, rS, rB ;
  283. : crbDcrbAcrbB  tab crbD, crbA, crbB ;
  284. : RCfrDfrB        ?RC tab frD, frB ;
  285. : RCfrDfrAfrB    ?RC tab frD, frA, frB ;
  286. : RCfrDfrAfrC    ?RC tab frD, frA, frC ;
  287. : RCfrDfrAfrCfrB ?RC tab frD, frA, frC, frB ;
  288. : disp(rA0)        11 15 extract 0= if disp else ?disp (rA) then ;
  289. : rDdisp(rA0)    tab rD, disp(rA0) ;
  290. : frDdisp(rA0)    tab frD, disp(rA0) ;
  291. : frDrA0rB        tab frD, rA0, rB ;
  292. : rSdisp(rA0)    tab rS, disp(rA0) ;
  293. : frSdisp(rA0)    tab frS, disp(rA0) ;
  294. : frSrA0rB        tab frS, rA0, rB ;
  295. : ?bCR            tab 11 13 extract ?dup if crfReg then ;
  296. : ?bCR,            11 13 extract ?dup if crfReg comma then ;
  297.  
  298.  
  299. d> Dadd        RCrDrArB ;
  300. d> Daddo    RCrDrArB ;
  301. d> Daddc    RCrDrArB ;
  302. d> Daddco    RCrDrArB ;
  303. d> Dadde    RCrDrArB ;
  304. d> Daddeo    RCrDrArB ;
  305. d> Daddi    rDrA0SIMM ;
  306. d> Daddic    rDrASIMM ;
  307. d> Daddic.    rDrASIMM ;
  308. d> Daddis    rDrA0SIMM ;
  309. d> Daddme    RCrDrA ;
  310. d> Daddmeo    RCrDrA ;
  311. d> Daddze    RCrDrA ;
  312. d> Daddzeo    RCrDrA ;
  313. d> Dand        RCrArSrB ;
  314. d> Dandc    RCrArSrB ;
  315. d> Dandi.    rArSUIMM ;
  316. d> Dandis.    rArSUIMM ;
  317. d> Db        ( ?lk ) ?aa ?lk tab li ;
  318. d> Dbc        1 trimOff cond ( ?lk ) ?aa ?lk ?predict tab ?bCR, bd ;
  319. d> Dbcctr    4 trimOff cond ( ?lk ) " ctr" put$ ?lk ?predict ?bCR ;
  320. d> Dbclr    3 trimOff cond ( ?lk ) " lr" put$ ?lk ?predict ?bCR ;
  321. d> Dcmp        tab crfD0, rA, rB ;
  322. d> Dcmpi    tab crfD0, rA, SIMM ;
  323. d> Dcmpl    tab crfD0, rA, rB ;
  324. d> Dcmpli    tab crfD0, rA, SIMM ;
  325. d> Dcntlzw    ?RC tab rA, rS ;
  326. d> Dcrand    crbDcrbAcrbB ;
  327. d> Dcrandc    crbDcrbAcrbB ;
  328. d> Dcreqv    crbDcrbAcrbB ;
  329. d> Dcrnand    crbDcrbAcrbB ;
  330. d> Dcrnor    crbDcrbAcrbB ;
  331. d> Dcror    crbDcrbAcrbB ;
  332. d> Dcrorc    crbDcrbAcrbB ;
  333. d> Dcrxor    crbDcrbAcrbB ;
  334. d> Ddcbf    rA0rB ;
  335. d> Ddcbi    rA0rB ;
  336. d> Ddcbst    rA0rB ;
  337. d> Ddcbt    rA0rB ;
  338. d> Ddcbtst    rA0rB ;
  339. d> Ddcbz    rA0rB ;
  340. d> Ddivw    RCrDrArB ;
  341. d> Ddivwo    RCrDrArB ;
  342. d> Ddivwu    RCrDrArB ;
  343. d> Ddivwuo    RCrDrArB ;
  344. d> Deciwx    rDrA0rB ;
  345. d> Decowx    rSrA0rB ;
  346. d> Deieio    ;
  347. d> Deqv        RCrSrArB ;
  348. d> Dextsb    RCrArS ;
  349. d> Dextsh    RCrArS ;
  350. d> Dfabs    RCfrDfrB ;
  351. d> Dfadd    RCfrDfrAfrB ;
  352. d> Dfadds    RCfrDfrAfrB ;
  353. d> Dfcmpo    tab crfD, frA, frB ;
  354. d> Dfcmpu    tab crfD, frA, frB ;
  355. d> Dfctiw    RCfrDfrB ;
  356. d> Dfctiwz    RCfrDfrB ;
  357. d> Dfdiv    RCfrDfrAfrB ;
  358. d> Dfdivs    RCfrDfrAfrB ;
  359. d> Dfmadd    RCfrDfrAfrCfrB ;
  360. d> Dfmadds    RCfrDfrAfrCfrB ;
  361. d> Dfmr        RCfrDfrB ;
  362. d> Dfmsub    RCfrDfrAfrCfrB ;
  363. d> Dfmsubs    RCfrDfrAfrCfrB ;
  364. d> Dfmul    RCfrDfrAfrC ;
  365. d> Dfmuls    RCfrDfrAfrC ;
  366. d> Dfnabs    RCfrDfrB ;
  367. d> Dfneg    RCfrDfrB ;
  368. d> Dfnmadd    RCfrDfrAfrCfrB ;
  369. d> Dfnmadds    RCfrDfrAfrCfrB ;
  370. d> Dfnmsub    RCfrDfrAfrCfrB ;
  371. d> Dfnmsubs    RCfrDfrAfrCfrB ;
  372. d> Dfrsp    RCfrDfrB ;
  373. d> Dfsub    RCfrDfrAfrB ;
  374. d> Dfsubs    RCfrDfrAfrB ;
  375. d> Dicbi    rA0rB ;
  376. d> Disync    ;
  377. d> Dlbz        rDdisp(rA0) ;
  378. d> Dlbzu    rDdisp(rA0) ;
  379. d> Dlbzux    rDrA0rB ;
  380. d> Dlbzx    rDrA0rB ;
  381. d> Dlfd        frDdisp(rA0) ;
  382. d> Dlfdu    frDdisp(rA0) ;
  383. d> Dlfdux    frDrA0rB ;
  384. d> Dlfdx    frDrA0rB ;
  385. d> Dlfs        frDdisp(rA0) ;
  386. d> Dlfsu    frDdisp(rA0) ;
  387. d> Dlfsux    frDrA0rB ;
  388. d> Dlfsx    frDrA0rB ;
  389. d> Dlha        rDdisp(rA0) ;
  390. d> Dlhau    rDdisp(rA0) ;
  391. d> Dlhaux    rDrA0rB ;
  392. d> Dlhax    rDrA0rB ;
  393. d> Dlhbrx    rDrA0rB ;
  394. d> Dlhz        rDdisp(rA0) ;
  395. d> Dlhzu    rDdisp(rA0) ;
  396. d> Dlhzux    rDrA0rB ;
  397. d> Dlhzx    rDrA0rB ;
  398. d> Dlmw        rDdisp(rA0) ;
  399. d> Dlswi    tab rD, rA0, NB ;
  400. d> Dlswx    rDrA0rB ;
  401. d> Dlwarx    rDrA0rB ;
  402. d> Dlwbrx    rDrA0rB ;
  403. d> Dlwz        rDdisp(rA0) ;
  404. d> Dlwzu    rDdisp(rA0) ;
  405. d> Dlwzux    rDrA0rB ;
  406. d> Dlwzx    rDrA0rB ;
  407. d> Dmcrf    tab crfD, crfS ;
  408. d> Dmcrfs    tab crfD, crfS ;
  409. d> Dmcrxr    tab crfD ;
  410. d> Dmfcr    tab rD ;
  411. d> Dmffs    ?rc tab frD ;
  412. d> Dmfmsr    tab rD ;
  413. d> Dmfspr    tab rD, SPR ;
  414. d> Dmfsr    tab rD, SR ;
  415. d> Dmfsrin    tab rD, rB ;
  416. d> Dmtcrf    tab CRM, rS ;
  417. d> Dmtfsb0    ?rc tab crbD ;
  418. d> Dmtfsb1    ?rc tab crbD ;
  419. d> Dmtfsf    ?rc tab FM, frB ;
  420. d> Dmtfsfi    ?rc tab crfD, IMM ;
  421. d> Dmtmsr    tab rS ;
  422. d> Dmtspr    tab SPR, rS ;
  423. d> Dmtsr    tab SR, rS ;
  424. d> Dmtsrin    tab rS, rB ;
  425. d> Dmulhw    RCrDrArB ;
  426. d> Dmulhwu    RCrDrArB ;
  427. d> Dmullw    RCrDrArB ;
  428. d> Dmullwo    RCrDrArB ;
  429. d> Dmulli    rDrASIMM ;
  430. d> Dnand    RCrArSrB ;
  431. d> Dneg        RCrDrA ;
  432. d> Dnego    RCrDrA ;
  433. d> Dnor        RCrArSrB ;
  434. d> Dor        RCrArSrB ;
  435. d> Dorc        RCrArSrB ;
  436. d> Dori        rArSUIMM ;
  437. d> Doris    rArSUIMM ;
  438. d> Drfi        ;
  439. d> Drlwimi    ?rc tab rA, rS, SH, MB, ME ;
  440. d> Drlwinm    ?rc tab rA, rS, SH, MB, ME ;
  441. d> Drlwnm    ?rc tab rA, rS, rB, MB, ME ;
  442. d> Dsc         ;
  443. d> Dslw        RCrArSrB ;
  444. d> Dsraw    RCrArSrB ;
  445. d> Dsrawi    ?rc tab rA, Rs, SH ;
  446. d> Dsrw        RCrArSrB ;
  447. d> Dstb        rSdisp(rA0) ;
  448. d> Dstbu    rSdisp(rA0) ;
  449. d> Dstbux    rSrA0rB ;
  450. d> Dstbx    rSrA0rB ;
  451. d> Dstfd    frSdisp(rA0) ;
  452. d> Dstfdu    frSdisp(rA0) ;
  453. d> Dstfdux    frSrA0rB ;
  454. d> Dstfdx    frSrA0rB ;
  455. d> Dstfs    frSdisp(rA0) ;
  456. d> Dstfsu    frSdisp(rA0) ;
  457. d> Dstfsux    frSrA0rB ;
  458. d> Dstfsx    frSrA0rB ;
  459. d> Dsth        rSdisp(rA0) ;
  460. d> Dsthbrx    rSrA0rB ;
  461. d> Dsthu    rSdisp(rA0) ;
  462. d> Dsthux    rSrA0rB ;
  463. d> Dsthx    rSrA0rB ;
  464. d> Dstmw    rSdisp(rA0) ;
  465. d> Dstswi    tab rS, rA0, NB ;
  466. d> Dstswx    rSrA0rB ;
  467. d> Dstw        rSdisp(rA0) ;
  468. d> Dstwbrx    rSrA0rB ;
  469. d> Dstwcx.    rSrA0rB ;
  470. d> Dstwu    rSdisp(rA0) ;
  471. d> Dstwux    rSrA0rB ;
  472. d> Dstwx    rSrA0rB ;
  473. d> Dsubf    RCrDrArB ;
  474. d> Dsubfo    RCrDrArB ;
  475. d> Dsubfc    RCrDrArB ;
  476. d> Dsubfco    RCrDrArB ;
  477. d> Dsubfe    RCrDrArB ;
  478. d> Dsubfeo    RCrDrArB ;
  479. d> Dsubfic    rDrASIMM ;
  480. d> Dsubfme    RCrDrA ;
  481. d> Dsubfmeo    RCrDrA ;
  482. d> Dsubfze    RCrDrA ;
  483. d> Dsubfzeo    RCrDrA ;
  484. d> Dsync    ;
  485. d> Dtlbie    tab rB ;
  486. d> Dtw        tab TO, rA, rB ;
  487. d> Dtwi        tab TO, rA, simm ;
  488. d> Dxor        RCrArSrB ;
  489. d> Dxori    rArSUIMM ;
  490. d> Dxoris    rArSUIMM ;
  491.  
  492.  
  493. create decode19List
  494.     0 , ' Dmcrf reloc,
  495.     16 , ' Dbclr reloc,
  496.     33 , ' Dcrnor reloc,
  497.     50 , ' Drfi reloc,
  498.     129 , ' Dcrandc reloc,
  499.     150 , ' Disync reloc,
  500.     193 , ' Dcrxor reloc,
  501.     225 , ' Dcrnand reloc,
  502.     257 , ' Dcrand reloc,
  503.     289 , ' Dcreqv reloc,
  504.     417 , ' Dcrorc reloc,
  505.     449 , ' Dcror reloc,
  506.     528 , ' Dbcctr reloc,
  507.     99999 , 0 , ( ### was token, )
  508.  
  509. create decode31List
  510.     0 , ' Dcmp reloc,
  511.     4 , ' Dtw reloc,
  512.     8 , ' Dsubfc reloc,
  513.     10 , ' Daddc reloc,
  514.     11 , ' Dmulhwu reloc,
  515.     19 , ' Dmfcr reloc,
  516.     20 , ' Dlwarx reloc,
  517.     23 , ' Dlwzx reloc,
  518.     24 , ' Dslw reloc,
  519.     26 , ' Dcntlzw reloc,
  520.     28 , ' Dand reloc,
  521.     32 , ' Dcmpl reloc,
  522.     40 , ' Dsubf reloc,
  523.     54 , ' Ddcbst reloc,
  524.     55 , ' Dlwzux reloc,
  525.     60 , ' Dandc reloc,
  526.     75 , ' Dmulhw reloc,
  527.     83 , ' Dmfmsr reloc,
  528.     86 , ' Ddcbf reloc,
  529.     87 , ' Dlbzx reloc,
  530.     104 , ' Dneg reloc,
  531. \    115 , ' Dmfpmr reloc,
  532.     119 , ' Dlbzux reloc,
  533.     124 , ' Dnor reloc,
  534.     136 , ' Dsubfe reloc,
  535.     138 , ' Dadde reloc,
  536.     144 , ' Dmtcrf reloc,
  537.     146 , ' Dmtmsr reloc,
  538.     150 , ' Dstwcx. reloc,
  539.     151 , ' Dstwx reloc,
  540. \    178 , ' Dmtpmr reloc,
  541.     183 , ' Dstwux reloc,
  542.     200 , ' Dsubfze reloc,
  543.     202 , ' Daddze reloc,
  544.     210 , ' Dmtsr reloc,
  545.     215 , ' Dstbx reloc,
  546.     232 , ' Dsubfme reloc,
  547.     234 , ' Daddme reloc,
  548.     235 , ' Dmullw reloc,
  549.     242 , ' Dmtsrin reloc,
  550.     246 , ' Ddcbtst reloc,
  551.     247 , ' Dstbux reloc,
  552.     266 , ' Dadd reloc,
  553. \    275 , ' Dmftb reloc,
  554.     278 , ' Ddcbt reloc,
  555.     279 , ' Dlhzx reloc,
  556.     284 , ' Deqv reloc,
  557.     306 , ' Dtlbie reloc,
  558. \    307 , ' Dmftbu reloc,
  559.     310 , ' Deciwx reloc,
  560.     311 , ' Dlhzux reloc,
  561.     316 , ' Dxor reloc,
  562.     339 , ' Dmfspr reloc,
  563.     343 , ' Dlhax reloc,
  564.     375 , ' Dlhaux reloc,
  565. \    403 , ' Dmttb reloc,
  566.     407 , ' Dsthx reloc,
  567.     412 , ' Dorc reloc,
  568. \    434 , ' Dslbia reloc,
  569. \    435 , ' Dmttbu reloc,
  570.     438 , ' Decowx reloc,
  571.     439 , ' Dsthux reloc,
  572.     444 , ' Dor reloc,
  573.     459 , ' Ddivwu reloc,
  574. \    466 , ' Dslbiex reloc,
  575.     467 , ' Dmtspr reloc,
  576.     470 , ' Ddcbi reloc,
  577.     476 , ' Dnand reloc,
  578.     491 , ' Ddivw reloc,
  579. \    498 , ' Dslbia reloc,
  580.     520 , ' Dsubfco reloc,
  581.     522 , ' Daddco reloc,
  582.     512 , ' Dmcrxr reloc,
  583.     533 , ' Dlswx reloc,
  584.     534 , ' Dlwbrx reloc,
  585.     535 , ' Dlfsx reloc,
  586.     536 , ' Dsrw reloc,
  587.     552 , ' Dsubfo reloc,
  588.     567 , ' Dlfsux reloc,
  589.     572 , ' Daddco reloc,
  590.     595 , ' Dmfsr reloc,
  591.     597 , ' Dlswi reloc,
  592.     598 , ' Dsync reloc,
  593.     599 , ' Dlfdx reloc,
  594.     616 , ' Dnego reloc,
  595.     631 , ' Dlfdux reloc,
  596.     648 , ' Dsubfeo reloc,
  597.     650 , ' Daddeo reloc,
  598.     659 , ' Dmfsrin reloc,
  599.     661 , ' Dstswx reloc,
  600.     662 , ' Dstwbrx reloc,
  601.     663 , ' Dstfsx reloc,
  602.     695 , ' Dstfsux reloc,
  603.     711 , ' Dmtfsf reloc,
  604.     712 , ' Dsubfzeo reloc,
  605.     714 , ' Daddzeo reloc,
  606.     725 , ' Dstswi reloc,
  607.     727 , ' Dstfdx reloc,
  608.     744 , ' Dsubfmeo reloc,
  609.     746 , ' Daddmeo reloc,
  610.     747 , ' Dmullwo reloc,
  611.     759 , ' Dstfdux reloc,
  612.     778 , ' Daddo reloc,
  613.     790 , ' Dlhbrx reloc,
  614.     792 , ' Dsraw reloc,
  615.     824 , ' Dsrawi reloc,
  616.     854 , ' Deieio reloc,
  617.     918 , ' Dsthbrx reloc,
  618.     922 , ' Dextsh reloc,
  619.     954 , ' Dextsb reloc,
  620.     971 , ' Ddivwuo reloc,
  621.     982 , ' Dicbi reloc,
  622. \    983 , ' Dstfiwx reloc,
  623.     1003 , ' Ddivwo reloc,
  624.     1014 , ' Ddcbz reloc,
  625.     99999 , 0 , ( ### was token, )
  626.  
  627. create decode59List
  628.     18 , ' Dfdivs reloc,
  629.     20 , ' Dfsubs reloc,
  630.     21 , ' Dfadds reloc,
  631. \    22 , ' Dfrsqrts reloc,
  632. \    24 , ' Dfres reloc,
  633.     -25 , ' Dfmuls reloc,
  634.     -28 , ' Dfmsubs reloc,
  635.     -29 , ' Dfmadds reloc,
  636.     -30 , ' Dfnmsubs reloc,
  637.     -31 , ' Dfnmadds reloc,
  638.     99999 , 0 , ( ### was token, )
  639.  
  640. create decode63List
  641.     0 , ' Dfcmpu reloc,
  642.     12 , ' Dfrsp reloc,
  643.     14 , ' Dfctiw reloc,
  644.     15 , ' Dfctiwz reloc,
  645.     18 , ' Dfdiv reloc,
  646.     20 , ' Dfsub reloc,
  647.     21 , ' Dfadd reloc,
  648. \    22 , ' Dfsqrt reloc,
  649. \    -23 , ' Dfsel reloc,
  650.     -25 , ' Dfmul reloc,
  651. \    26 , ' Dfsqrte reloc,
  652.     -28 , ' Dfmsub reloc,
  653.     -29 , ' Dfmadd reloc,
  654.     -30 , ' Dfnmsub reloc,
  655.     -31 , ' Dfnmadd reloc,
  656.     32 , ' Dfcmpo reloc,
  657.     38 , ' Dmtfsb1 reloc,
  658.     40 , ' Dfneg reloc,
  659.     64 , ' Dmcrfs reloc,
  660.     70 , ' Dmtfsb0 reloc,
  661.     72 , ' Dfmr reloc,
  662.     134 , ' Dmtfsfi reloc,
  663.     136 , ' Dfnabs reloc,
  664.     264 , ' Dfabs reloc,
  665.     583 , ' Dmffs reloc,
  666.     99999 , 0 , ( ### was token, )
  667.  
  668. : invalid ( -- )     \ " INVALID INSTR: " put$ curInstr putULong
  669. ;
  670.  
  671. : ListExecute  ( list ) { addr \ opcode subopcode -- }
  672.     21 30 extract  -> opcode
  673.     26 30 extract  -> subopcode
  674.     BEGIN
  675.         addr @ dup 0< if negate subopcode else opcode then <>
  676.     WHILE    
  677.         addr @ 99999 <>
  678.     WHILE
  679.         addr cell+ cell+  -> addr
  680.     REPEAT
  681.     THEN
  682.     addr @ dup 0< if negate subopcode else opcode then =
  683.     IF        addr 4+ @abs execute
  684.     ELSE    invalid
  685.     THEN  ;
  686.  
  687.  
  688. : d19  ( -- )  decode19List listExecute ;
  689. : d31  ( -- )  decode31List listExecute ;
  690. : d59  ( -- )  decode59List listExecute ;
  691. : d63  ( -- )  decode63List listExecute ;
  692.  
  693.  
  694. (*  Note: this isn't ANSI at all.  I'll have to replace with difficulty!
  695.  
  696. create decodeTable ]
  697. ( 0)    invalid    invalid    invalid Dtwi    invalid    invalid    invalid    Dmulli
  698. ( 8)    Dsubfic    invalid    Dcmpli    Dcmpi    Daddic    Daddic.    Daddi    Daddis
  699. ( 16)    Dbc        Dsc        Db        D19        Drlwimi    Drlwinm    invalid    Drlwnm
  700. ( 24)    Dori    Doris    Dxori    Dxoris    Dandi.    Dandis.    invalid    D31
  701. ( 32)    Dlwz    Dlwzu    Dlbz    Dlbzu    Dstw    Dstwu    Dstb    Dstbu
  702. ( 40)    Dlhz    Dlhzu    Dlha    Dlhau    Dsth    Dsthu    Dlmw    Dstmw
  703. ( 48)    Dlfs    Dlfsu    Dlfd    Dlfdu    Dstfs    Dstfsu    Dstfd    Dstfdu
  704. ( 56)    invalid    invalid    invalid    D59        invalid    invalid    invalid    D63
  705. [
  706. **** *)
  707.  
  708. create decodeTable
  709.  
  710. ( 0)    ' invalid reloc,        ' invalid reloc,    
  711.         ' invalid reloc,        ' Dtwi reloc,
  712.         ' invalid reloc,        ' invalid reloc,
  713.         ' invalid reloc,        ' Dmulli reloc,
  714. ( 8)    ' Dsubfic reloc,        ' invalid reloc,
  715.         ' Dcmpli reloc,            ' Dcmpi reloc,
  716.         ' Daddic reloc,            ' Daddic. reloc,
  717.         ' Daddi reloc,            ' Daddis reloc,
  718. ( 16)    ' Dbc reloc,            ' Dsc reloc,
  719.         ' Db reloc,                ' D19 reloc,        
  720.         ' Drlwimi reloc,        ' Drlwinm reloc,
  721.         ' invalid reloc,        ' Drlwnm reloc,
  722. ( 24)    ' Dori reloc,            ' Doris reloc,
  723.         ' Dxori reloc,            ' Dxoris reloc,
  724.         ' Dandi. reloc,            ' Dandis. reloc,
  725.         ' invalid reloc,        ' D31 reloc,
  726. ( 32)    ' Dlwz reloc,            ' Dlwzu reloc,
  727.         ' Dlbz reloc,            ' Dlbzu reloc,
  728.         ' Dstw reloc,            ' Dstwu reloc,
  729.         ' Dstb reloc,            ' Dstbu reloc,
  730. ( 40)    ' Dlhz reloc,            ' Dlhzu reloc,
  731.         ' Dlha reloc,            ' Dlhau reloc,
  732.         ' Dsth reloc,            ' Dsthu reloc,
  733.         ' Dlmw reloc,            ' Dstmw reloc,
  734. ( 48)    ' Dlfs reloc,            ' Dlfsu reloc,
  735.         ' Dlfd reloc,            ' Dlfdu reloc,
  736.         ' Dstfs reloc,            ' Dstfsu reloc,
  737.         ' Dstfd reloc,            ' Dstfdu reloc,
  738. ( 56)    ' invalid reloc,        ' invalid reloc,
  739.         ' invalid reloc,        ' D59 reloc,
  740.         ' invalid reloc,        ' invalid reloc,
  741.         ' invalid    reloc,        ' D63 reloc,
  742.  
  743.  
  744. : decode  ( -- | disassembles instruction curInstr at address curAddr )
  745.     0 5 extract            \ primary opcode
  746.     1cell * decodeTable + token@ execute ;
  747.  
  748.  
  749. : place.addr ( -- | put hex of addr into text )
  750.     base >r hex
  751.     curAddr 0 <# bl hold  & : hold # # # # # # # # #>
  752.         hex.text append.text 
  753.     r> -> base ; 
  754.  
  755. 16 constant instruction.column
  756.  
  757. : col    @xy drop  ;
  758.  
  759. : printInstrText
  760.     instruction.column col - spaces
  761.     instrText count type
  762.     instrText 1+ 3  " bl " s=
  763.     IF            \ it's a bl - we'll print the name of the called word
  764.         lastAddr 2-  3 spaces .name
  765.     THEN
  766. ;
  767.  
  768. : next.word ( -- word | get instruction, append to hex.text, bump address )
  769.     curAddr @
  770.     4 +> curAddr
  771.     dup 
  772.     base >r hex 
  773.     0 <# bl hold # # # # # # # # #> hex.text append.text 
  774.     r> -> base ;
  775.  
  776.  
  777. : .colonHdr { instr \ #P #PL #rslts -- }
  778.         \ types the info for a colon header
  779.  
  780.     curInstr -> instr
  781.     cr cr hex.text count type
  782.     ."  : " curAddr 2- .name
  783.     instr  $ 8000 and
  784.     IF    ."   leaf "  ELSE  ."   non-leaf " THEN
  785.     instr  $ F and  -> #PL
  786.     instr  4 >>  $ F and  -> #P
  787.     instr  8 >>  $ F and  -> #rslts
  788.     ."  #named parms: " #P .
  789.     ."  #locals: " #PL #P - .
  790.     ."  #results: " #rslts .
  791. ;
  792.  
  793.  
  794. : .extern  { addr len instr -- }
  795.     cr cr hex.text count type  addr len type
  796.     2 spaces  curAddr 2- .name
  797.     instr        $ FF and  ."  #parms: " .
  798.     instr 8 >>    $ FF and  ."  #results: " .
  799. ;
  800.  
  801.  
  802. : nextInstr { \ instr #P #PL #rslts -- }
  803.         \ disassembles the next instruction
  804.  
  805.     instrText off
  806.     hex.text  off 
  807.     place.addr                \ put in address of instruction
  808.     next.word -> curInstr    \ get the instruction itself
  809.  
  810.     curInstr -> instr
  811.     
  812. \ now we check if this is a special case, and if so, we handle it
  813.  
  814.     instr 24 >>  $ BE =     IF  instr .colonHdr    EXIT  THEN
  815.     instr 16 >>  $ BF00 =    IF  "  extern"  instr .extern    EXIT  THEN
  816.     instr 16 >>  $ BF01 =    IF  "  sysCall" instr .extern    EXIT  THEN
  817.  
  818.     cr hex.text count type
  819.     decode                        \ decode it
  820.     printInstrText
  821. ;
  822.  
  823.  
  824. \ The exported words:
  825.  
  826. : DISASM_RNG ( from \ to -- )
  827. \    ppcdisassembler
  828.     swap -> curAddr
  829.     begin
  830.         nextInstr  ?pause
  831.         dup curAddr u<=
  832.     until drop ;
  833.  
  834. : DISASM_CNT ( from \ #instructions -- )
  835. \    ppcdisassembler
  836.     swap -> curAddr 0 do
  837.         nextInstr
  838.     loop ;
  839.  
  840. : DISASM_ONE  ( addr -- addr' )  
  841. \    ppcdisassembler
  842.     -> curAddr  nextInstr  curAddr ;
  843.  
  844. : ?ending-instr ( -- flag | is instr a return or jump? )
  845. \    ppcdisassembler
  846.     0 5 extract 19 =
  847.     21 31 extract dup 32 = swap 1056 = or and ;
  848.  
  849. : ?past-hiaddr ( -- flag | is PC past highest addr branched to)
  850. \    ppcdisassembler
  851.     curAddr hiAddr > ;
  852.  
  853. : DISASM  ( addr -- )    \ Exported.  The basic disassembly word.
  854. \    ppcdisassembler
  855.     -> curAddr
  856.     0 -> hiAddr
  857.     BEGIN
  858.         nextInstr  ?pause
  859.         ?ending-instr ?past-hiAddr and
  860.     UNTIL ;
  861.  
  862. : DISASM_WORD  ( -- )        \ continues until paused
  863.     '                    \ get xt (cfa) of next word in input
  864.     dup 3 and +            \ align cfa to 4-byte boundary
  865.     disasm ;
  866.  
  867. : DISASM_XT  ( xt -- )    \ continues until paused
  868.     dup locate_src        \ display source in QE
  869.     disasm ;            \  and disassemble from xt = cfa
  870.  
  871. \ set_disasm_call_range sets up the address range within which we try
  872. \  to display the name of a called word.  Since we mightn't be
  873. \  disassembling valid PPC code, we can't just assume an "address" is
  874. \  valid, or we might get sundry bus errors.
  875.  
  876. : SET_DISASM_CALL_RANGE        \ ( lo hi -- )
  877.     -> range_end  -> range_start  ;
  878.